home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-file.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-04-15  |  42.9 KB  |  2,279 lines
  1. /*  pl-file.c,v 1.22 1994/04/11 08:37:36 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: file system i/o
  8. */
  9.  
  10. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  11. This module is far too big.  It defines a layer around open(), etc.   to
  12. get  opening  and  closing  of  files to the symbolic level required for
  13. Prolog.  It also defines basic I/O  predicates,  stream  based  I/O  and
  14. finally  a  bundle  of  operations  on  files,  such  as name expansion,
  15. renaming, deleting, etc.  Most of this module is rather straightforward.
  16.  
  17. If time is there I will have a look at all this to  clean  it.   Notably
  18. handling times must be cleaned, but that not only holds for this module.
  19. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  20.  
  21. #if defined(__WINDOWS__) || defined(__NT__)
  22. #include "windows.h"
  23. #undef FD_SET
  24. #undef FD_ISSET
  25. #undef FD_ZERO
  26. #endif
  27.  
  28. #include "pl-incl.h"
  29. #include "pl-ctype.h"
  30. #ifdef __WIN32__
  31. #include <console.h>
  32. #endif
  33.  
  34. #ifdef HAVE_SYS_PARAM_H
  35. #include <sys/param.h>
  36. #endif
  37. #ifdef HAVE_SYS_FILE_H
  38. #include <sys/file.h>
  39. #endif
  40. #ifdef HAVE_UNISTD_H
  41. #include <unistd.h>
  42. #endif
  43. #ifdef HAVE_BSTRING_H
  44. #include <bstring.h>
  45. #endif
  46.  
  47. #define ST_TERMINAL 0            /* terminal based stream */
  48. #define ST_FILE        1            /* File bound stream */
  49. #define ST_PIPE        2            /* Pipe bound stream */
  50. #define ST_STRING   3            /* String bound stream */
  51.  
  52.                     /* openStream() flags */
  53. #define OPEN_OPEN   0x1            /* Open for open/[3,4] */
  54. #define OPEN_TEXT   0x2            /* Open in text-mode */
  55.  
  56. typedef struct plfile *    PlFile;
  57.  
  58. static struct plfile
  59. { atom_t    name;            /* name of file */
  60.   atom_t    stream_name;        /* stream identifier name */
  61.   IOSTREAM *    stream;            /* IOSTREAM package descriptor */
  62.   char        status;            /* F_CLOSED, F_READ, F_WRITE */
  63.   char        type;            /* ST_FILE, ST_PIPE, ST_STRING */
  64. } *fileTable = (PlFile) NULL;        /* Our file table */
  65.  
  66. int     Input;                /* current input */
  67. int    Output;                /* current output */
  68.  
  69. ttybuf    ttytab;                /* saved terminal status on entry */
  70. int    ttymode;            /* Current tty mode */
  71.  
  72. static atom_t prompt_atom;        /* current prompt */
  73. static char *first_prompt;        /* First-line prompt */
  74. static int first_prompt_used;        /* flag */
  75. static int protocolStream = -1;        /* doing protocolling on stream <n> */
  76.  
  77. static int   maxfiles;            /* maximum file index */
  78.  
  79. typedef struct input_context * InputContext;
  80. typedef struct output_context * OutputContext;
  81.  
  82. static struct input_context
  83. { int        stream;            /* pushed input */
  84.   atom_t    term_file;        /* old term_position file */
  85.   int        term_line;        /* old term_position line */
  86.   InputContext    previous;        /* previous context */
  87. } *input_context_stack = NULL;
  88.  
  89. static struct output_context
  90. { int        stream;            /* pushed input */
  91.   OutputContext previous;        /* previous context */
  92. } *output_context_stack = NULL;
  93.  
  94. forwards bool    openStream(term_t file, int mode, int flags);
  95. forwards bool    closeStream(int);
  96. forwards bool    unifyStreamName(term_t, int);
  97. forwards bool    unifyStreamNo(term_t, int);
  98. forwards bool    setUnifyStreamNo(term_t, int);
  99. forwards bool    unifyStreamMode(term_t, int);
  100. forwards int    Get0();
  101.  
  102. static jmp_buf pipe_context;        /* jmp buffer for pipe operations */
  103. static int inpipe;            /* doing a pipe operation */
  104.  
  105.  
  106. #ifdef SIGPIPE
  107. static void
  108. pipeHandler(int sig)
  109. { if ( inpipe )
  110.   { longjmp(pipe_context, 1);
  111.   }
  112.  
  113.   warning("Broken pipe\n");        /* Unexpected broken pipe */
  114.   pl_abort();
  115.  
  116.   signal(SIGPIPE, SIG_DFL);        /* should abort fail. */
  117.   kill(getpid(), SIGPIPE);        /* Unix has both pipes and kill() */
  118. }
  119. #endif /* SIGPIPE */
  120.  
  121. static void
  122. brokenPipe(int n, atom_t rw)
  123. { term_t stream = PL_new_term_ref();
  124.   unifyStreamNo(stream, n);
  125.   if ( rw == ATOM_write && n == Output )
  126.     Output = 1;
  127.   PL_error(NULL, 0, "Broken pipe", ERR_STREAM_OP, rw, stream);
  128. }
  129.  
  130. #define TRYPIPE(no, rw, code, err) \
  131.     if ( fileTable[(no)].type == ST_PIPE ) \
  132.     { if ( setjmp(pipe_context) != 0 ) \
  133.       { inpipe--; \
  134.         brokenPipe(no, rw); \
  135.         err; \
  136.       } else \
  137.       { inpipe++; \
  138.         code; \
  139.         inpipe--; \
  140.       } \
  141.     } else \
  142.     { code; \
  143.     }
  144.  
  145.  
  146. void
  147. initIO(void)
  148. { int n;
  149.  
  150.   fileerrors = TRUE;
  151.   if ( maxfiles != getdtablesize() )
  152.   { if ( fileTable != (PlFile) NULL )
  153.       freeHeap(fileTable, sizeof(struct plfile) * maxfiles);
  154.     maxfiles = getdtablesize();
  155.     fileTable = allocHeap(sizeof(struct plfile) * maxfiles);
  156.   }
  157.  
  158. #ifdef __unix__
  159.   if ( !isatty(0) || !isatty(1) )    /* Sinput is not a tty */
  160.     GD->cmdline.notty = TRUE;
  161. #endif
  162.  
  163. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  164. Initilise user input, output and error  stream.   How  to do this neatly
  165. without the Unix assumptions?
  166. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  167.  
  168.   for(n=0; n<maxfiles; n++)
  169.   { PlFile f = &fileTable[n];
  170.  
  171.     switch(n)
  172.     { case 0:
  173.     f->name              = ATOM_user;
  174.     f->stream_name    = ATOM_user_input;
  175.     f->stream         = Sinput;
  176.     f->status         = F_READ;
  177.     f->type              = ST_TERMINAL;
  178.     break;
  179.       case 1:
  180.     f->name           = ATOM_user;
  181.     f->stream_name    = ATOM_user_output;
  182.     f->stream         = Soutput;
  183.     f->status         = F_WRITE;
  184.     f->type              = ST_TERMINAL;
  185.     break;
  186.       case 2:
  187.     f->name           = ATOM_stderr;
  188.     f->stream_name    = ATOM_user_error;
  189.     f->stream         = Serror;
  190.     f->status         = F_WRITE;
  191.     f->type              = ST_TERMINAL;
  192.     break;
  193.       default:
  194.     f->name           = NULL_ATOM;
  195.         f->stream         = NULL_ATOM;
  196.     f->type           = ST_FILE;
  197.     f->status         = F_CLOSED;
  198.     }
  199.   }
  200.  
  201.   ResetTty();
  202.   Sinput->position  = &Sinput->posbuf;    /* position logging */
  203.   Soutput->position = &Sinput->posbuf;
  204.   Serror->position  = &Sinput->posbuf;
  205.  
  206.   ttymode = TTY_COOKED;
  207.   PushTty(&ttytab, TTY_SAVE);
  208.  
  209.   Input = 0;
  210.   Output = 1;
  211.  
  212.   if ( prompt_atom == NULL_ATOM )
  213.     prompt_atom = ATOM_prompt;
  214. }
  215.  
  216.  
  217. void
  218. dieIO()
  219. { if ( GD->io_initialised )
  220.   { pl_noprotocol();
  221.     closeFiles(TRUE);
  222.     PopTty(&ttytab);
  223.   }
  224. }
  225.  
  226.  
  227. static bool
  228. closeStream(int n)
  229. { PlFile f = &fileTable[n];
  230.  
  231.   if ( f->stream )
  232.   { switch(n)
  233.     { case 0:
  234.     Sclearerr(f->stream);
  235.         break;
  236.       case 1:
  237.       case 2:
  238.     Sflush(f->stream);
  239.         break;
  240.       default:
  241.     if ( f->status == F_WRITE )
  242.     { TRYPIPE(n, ATOM_write, Sclose(f->stream), (void)0);
  243.     } else
  244.       Sclose(f->stream);
  245.         f->stream = NULL_ATOM;
  246.     f->name   = NULL_ATOM;
  247.     f->status = F_CLOSED;
  248.     break;
  249.     }
  250.   }
  251.  
  252.   succeed;
  253. }
  254.  
  255.  
  256. void
  257. closeFiles(int all)
  258. { volatile int n;
  259. #if O_PCE
  260.   extern int read_nesting;
  261.   read_nesting = 0;
  262. #endif
  263.  
  264.   for(n=0; n<maxfiles; n++)
  265.   { IOSTREAM *s;
  266.  
  267.     if ( (s=fileTable[n].stream) )
  268.     { if ( all || !(s->flags & SIO_NOCLOSE) )
  269.     closeStream(n);
  270.       else if ( fileTable[n].status == F_WRITE )
  271.       {    TRYPIPE(n, ATOM_write, Sflush(s), (void)0);
  272.       }
  273.     }
  274.   }
  275.  
  276.   Input = 0;
  277.   Output = 1;
  278. }
  279.  
  280.  
  281. void
  282. protocol(char *s, int n)
  283. { if ( protocolStream >= 0 )
  284.   { int out;
  285.   
  286.     out = Output;
  287.     Output = protocolStream;
  288.     for( ; n > 0; s++, n--)
  289.       Put((int)*s & 0xff);
  290.     Output = out;
  291.   }
  292. }
  293.  
  294.  
  295. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  296. push/popInputContext() maintain the source_location   info  over see(X),
  297. ..., seen(X). This is very  hairy.   Note  the common seeing(O), see(N),
  298. ..., seen, see(O) construct. To fix this   one, see/1 will only push the
  299. context if it concerns a new stream and seen() will only pop if it is an
  300. open stream.
  301.  
  302. Should be fixed decently if we redesign all of I/O stream management.
  303. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  304.  
  305. static void
  306. pushInputContext()
  307. { InputContext c = allocHeap(sizeof(struct input_context));
  308.  
  309.   c->stream           = Input;
  310.   c->term_file        = source_file_name;
  311.   c->term_line        = source_line_no;
  312.   c->previous         = input_context_stack;
  313.   input_context_stack = c;
  314. }
  315.  
  316.  
  317. static void
  318. popInputContext()
  319. { InputContext c = input_context_stack;
  320.  
  321.   if ( c )
  322.   { Input               = c->stream;
  323.     source_file_name    = c->term_file;
  324.     source_line_no      = c->term_line;
  325.     input_context_stack = c->previous;
  326.     freeHeap(c, sizeof(struct input_context));
  327.   } else
  328.     Input = 0;
  329. }
  330.  
  331. static void
  332. pushOutputContext()
  333. { OutputContext c = allocHeap(sizeof(struct output_context));
  334.  
  335.   c->stream            = Output;
  336.   c->previous          = output_context_stack;
  337.   output_context_stack = c;
  338. }
  339.  
  340.  
  341. static void
  342. popOutputContext()
  343. { OutputContext c = output_context_stack;
  344.  
  345.   if ( c )
  346.   { Output               = c->stream;
  347.     output_context_stack = c->previous;
  348.     freeHeap(c, sizeof(struct output_context));
  349.   } else
  350.     Output = 0;
  351. }
  352.  
  353.  
  354. int
  355. currentLinePosition()
  356. { IOSTREAM *stream = fileTable[Output].stream;
  357.  
  358.   if ( stream && stream->position )
  359.     return stream->position->linepos;
  360.  
  361.   return 0;
  362. }
  363.  
  364.  
  365. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  366. Get a single character from the terminal without waiting for  a  return.
  367. The  character  should  not  be  echoed.   If  GD->cmdline.notty is true this
  368. function will read the first character and then skip all character  upto
  369. and including the newline.
  370. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  371.  
  372. int
  373. getSingleChar(void)
  374. { int c;
  375.   int OldIn = Input;
  376.   ttybuf buf;
  377.   IOSTREAM *stream;
  378.     
  379.   Input = 0;
  380.   stream = fileTable[Input].stream;
  381.   debugstatus.suspendTrace++;
  382.   pl_ttyflush();
  383.   PushTty(&buf, TTY_RAW);        /* just donot prompt */
  384.   
  385.   if ( GD->cmdline.notty )
  386.   { Char c2;
  387.  
  388.     c2 = Get0();
  389.     while( c2 == ' ' || c2 == '\t' )    /* skip blanks */
  390.       c2 = Get0();
  391.     c = c2;
  392.     while( c2 != EOF && c2 != '\n' )    /* read upto newline */
  393.       c2 = Get0();
  394.   } else
  395.   { if ( stream->position )
  396.     { IOPOS oldpos = *stream->position;
  397.       c = Get0();
  398.       *stream->position = oldpos;
  399.     } else
  400.       c = Get0();
  401.   }
  402.  
  403.   PopTty(&buf);
  404.   debugstatus.suspendTrace--;
  405.   Input = OldIn;
  406.  
  407.   return c;
  408. }
  409.  
  410.  
  411. word
  412. pl_rawtty(term_t goal)
  413. { bool rval;
  414.   int OldIn = Input;
  415.   ttybuf buf;
  416.     
  417.   Input = 0;
  418.   debugstatus.suspendTrace++;
  419.   pl_ttyflush();
  420.   PushTty(&buf, TTY_RAW);
  421.  
  422.   rval = callProlog(NULL, goal, FALSE);
  423.  
  424.   PopTty(&buf);
  425.   debugstatus.suspendTrace--;
  426.  
  427.   Input = OldIn;
  428.  
  429.   return rval;
  430. }
  431.  
  432.  
  433. #ifndef DEL
  434. #define DEL 127
  435. #endif
  436.  
  437. bool
  438. readLine(char *buffer)
  439. { int oldin = Input;
  440.   int oldout = Output;
  441.   int c;
  442.   char *buf = &buffer[strlen(buffer)];
  443.   ttybuf tbuf;
  444.  
  445.   Input = 0;
  446.   Output = 1;
  447.   if ( !GD->cmdline.notty )
  448.     PushTty(&tbuf, TTY_RAW);        /* just donot prompt */
  449.  
  450.   for(;;)
  451.   { pl_flush();
  452.  
  453.     switch( (c=Get0()) )
  454.     { case '\n':
  455.       case '\r':
  456.       case EOF:
  457.         *buf++ = EOS;
  458.         Input = oldin;
  459.     Output = oldout;
  460.     if ( !GD->cmdline.notty )
  461.       PopTty(&tbuf);
  462.  
  463.     return c == EOF ? FALSE : TRUE;
  464.       case '\b':
  465.       case DEL:
  466.     if ( !GD->cmdline.notty && buf > buffer )
  467.     { Putf("\b \b");
  468.       buf--;
  469.     }
  470.       default:
  471.     if ( !GD->cmdline.notty )
  472.       Put(c);
  473.     *buf++ = c;
  474.     }
  475.   }
  476. }
  477.  
  478.  
  479. bool
  480. LockStream()
  481. { IOSTREAM *s = fileTable[Output].stream;
  482.  
  483.   return (s && Slock(s) < 0) ? FALSE : TRUE;
  484. }
  485.  
  486.  
  487. bool
  488. UnlockStream()
  489. { IOSTREAM *s = fileTable[Output].stream;
  490.  
  491.   return (s && Sunlock(s) < 0) ? FALSE : TRUE;
  492. }
  493.  
  494.  
  495. bool
  496. Put(int c)
  497. { IOSTREAM *s = fileTable[Output].stream;
  498.   int rval;
  499.  
  500.   if ( !s )
  501.     fail;
  502.  
  503.   TRYPIPE(Output, ATOM_write, rval = Sputc(c, s), rval = -1);
  504.  
  505.   return rval < 0 ? FALSE : TRUE;
  506. }
  507.  
  508.  
  509. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  510. PutOpenToken() inserts a space in the output stream if the last-written
  511. and given character require a space to ensure a token-break.
  512. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  513.  
  514. bool
  515. PutOpenToken(int c)
  516. { IOSTREAM *s = fileTable[Output].stream;
  517.   
  518.   if ( c == EOF )
  519.   { s->lastc = EOF;
  520.     succeed;
  521.   }
  522.  
  523.   if ( s->lastc != EOF &&
  524.        ((isAlpha(s->lastc) && isAlpha(c)) ||
  525.     (isSymbol(s->lastc) && isSymbol(c)) ||
  526.     c == '(') )
  527.     return Put(' ');
  528.  
  529.   succeed;
  530. }
  531.  
  532.  
  533. bool
  534. Puts(const char *str)
  535. { IOSTREAM *s = fileTable[Output].stream;
  536.   int rval;
  537.  
  538.   if ( !s )
  539.     fail;
  540.  
  541.   TRYPIPE(Output, ATOM_write, rval = Sfputs(str, s), rval = -1);
  542.  
  543.   return rval < 0 ? FALSE : TRUE;
  544. }
  545.  
  546.  
  547. word
  548. Putf(char *fm, ...)
  549. { IOSTREAM *s = fileTable[Output].stream;
  550.   va_list args;
  551.   int rval;
  552.  
  553.   if ( !s )
  554.     fail;
  555.  
  556.   va_start(args, fm);
  557.   TRYPIPE(Output, ATOM_write, rval = Svfprintf(s, fm, args), rval = -1);
  558.   va_end(args);
  559.  
  560.   return rval < 0 ? FALSE : TRUE;
  561. }
  562.  
  563.  
  564. static int
  565. Get0()
  566. { IOSTREAM *s = fileTable[Input].stream;
  567.   int c;
  568.   
  569.   if ( s )
  570.   { TRYPIPE(Input, ATOM_read, c=Sgetc(s), c=EOF);
  571.     
  572.     if ( c == EOF && Sfpasteof(s) )
  573.     { term_t stream = PL_new_term_ref();
  574.  
  575.       unifyStreamNo(stream, Input);
  576.       PL_error(NULL, 0, NULL, ERR_PERMISSION,
  577.            ATOM_input, ATOM_past_end_of_stream, stream);
  578.     }
  579.   } else
  580.     c = EOF;
  581.  
  582.   return c;
  583. }
  584.  
  585.  
  586. IOSTREAM *
  587. PL_current_input()
  588. { return fileTable[Input].stream;
  589. }
  590.  
  591.  
  592. IOSTREAM *
  593. PL_current_output()
  594. { return fileTable[Output].stream;
  595. }
  596.  
  597.  
  598. word
  599. pl_dup_stream(term_t from, term_t to)
  600. { int fn, tn;
  601.   PlFile f, t;
  602.  
  603.   if ( (fn = streamNo(from, F_ANY)) < 0 ||
  604.        (tn = streamNo(to, F_ANY)) < 0 )
  605.     fail;
  606.  
  607.   f = &fileTable[fn];
  608.   t = &fileTable[tn];
  609.  
  610.   t->stream = f->stream;
  611.   t->status = f->status;
  612.   t->type   = f->type;
  613.  
  614.   succeed;
  615. }
  616.  
  617.  
  618. bool
  619. PL_open_stream(term_t handle, IOSTREAM *s)
  620. { int n;
  621.   PlFile f;
  622.  
  623.   for(n=3, f=&fileTable[n]; n<maxfiles; n++, f++)
  624.   { if ( !f->stream )
  625.     { f->stream = s;
  626.       f->name   = NULL_ATOM;
  627.       f->type   = ST_FILE;
  628.       if ( s->flags & SIO_INPUT )
  629.     f->status = F_READ;
  630.       else
  631.     f->status = F_WRITE;
  632.  
  633.       return setUnifyStreamNo(handle, n);
  634.     }
  635.   }
  636.  
  637.   return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_files);
  638. }
  639.  
  640.  
  641. static bool
  642. openStream(term_t file, int mode, int flags)
  643. { int n;
  644.   IOSTREAM *stream;
  645.   char cmode[3];
  646.   atom_t name;
  647.   functor_t f;
  648.   int type;
  649.  
  650.   DEBUG(2, Sdprintf("openStream file=0x%lx, mode=%d\n", file, mode));
  651.  
  652.   if ( PL_get_atom(file, &name) )
  653.   { type = ST_FILE;
  654.   } else if ( PL_get_functor(file, &f) && f == FUNCTOR_pipe1)
  655.   {
  656. #ifdef SIGPIPE
  657.     term_t an = PL_new_term_ref();
  658.     type = ST_PIPE;
  659.     
  660.     if ( !PL_get_arg(1, file, an) ||
  661.      !PL_get_atom(an, &name) )
  662.       return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_source_sink, file);
  663.  
  664.     signal(SIGPIPE, pipeHandler);
  665. #else
  666.     return PL_error(NULL, 0, NULL, ERR_NOTIMPLEMENTED, ATOM_pipe);
  667. #endif /*SIGPIPE*/
  668.   } else
  669.     return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_source_sink, file);
  670.  
  671.   DEBUG(3, Sdprintf("File/command name = %s\n", stringAtom(name)));
  672.   if ( type == ST_FILE )
  673.   { if ( mode == F_READ )
  674.     { if ( name == ATOM_user || name == ATOM_user_input )
  675.       { Input = 0;
  676.     succeed;
  677.       }
  678.     } else
  679.     { if ( name == ATOM_user || name == ATOM_user_output )
  680.       { Output = 1;
  681.         succeed;
  682.       }
  683.       if ( name == ATOM_user_error || name == ATOM_stderr )
  684.       { Output = 2;
  685.     succeed;
  686.       }
  687.     }
  688.   } else if ( type == ST_PIPE && (mode == F_APPEND || mode == F_WRNOTRUNC) )
  689.   { term_t tmp = PL_new_term_ref();
  690.     
  691.     PL_put_atom(tmp, (mode == F_APPEND ? ATOM_append : ATOM_update));
  692.     return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_io_mode, tmp);
  693.   }
  694.     
  695.   if ( !(flags & OPEN_OPEN) )        /* see/1, tell/1, append/1 */
  696.   { for( n=0; n<maxfiles; n++ )
  697.     { if ( fileTable[n].name == name && fileTable[n].type == type )
  698.       { if ( fileTable[n].status == mode )
  699.     { switch(mode)
  700.       { case F_READ:    Input = n; break;
  701.         case F_WRITE:
  702.         case F_WRNOTRUNC:
  703.         case F_APPEND:    Output = n; break;
  704.       }
  705.       DEBUG(3, Sdprintf("Switched back to already open stream %d\n", n));
  706.       succeed;
  707.     } else
  708.     { closeStream(n);
  709.     }
  710.     break;
  711.       }
  712.     }
  713.  
  714.     if ( mode == F_READ )
  715.       pushInputContext();        /* see/1 to a new file */
  716.   }
  717.  
  718.   DEBUG(2, Sdprintf("Starting Unix open\n"));
  719.   cmode[0] = FOPENMODE[mode];
  720.   if ( flags & OPEN_TEXT )
  721.     cmode[1] = EOS;
  722.   else
  723.   { cmode[1] = 'b';
  724.     cmode[2] = EOS;
  725.   }
  726.  
  727. #ifdef HAVE_POPEN
  728.   if ( type == ST_PIPE )
  729.   { if ( !(stream=Sopen_pipe(stringAtom(name), cmode)) )
  730.       goto err;
  731.   } else
  732. #endif /*HAVE_POPEN*/
  733.   { char *fn;
  734.     char tmp[MAXPATHLEN];
  735.  
  736.     if ( !(fn = ExpandOneFile(stringAtom(name), tmp)) )
  737.       fail;
  738.  
  739.     if ( !(stream=Sopen_file(fn, cmode)) )
  740.     {
  741. #ifdef HAVE_POPEN
  742.       err:
  743. #endif
  744.       if ( fileerrors )
  745.       { PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION,
  746.          ATOM_open, ATOM_source_sink, file);
  747.       }
  748.       fail;
  749.     }
  750.   }
  751.  
  752.   for(n=3; n<maxfiles; n++)
  753.   { if ( !fileTable[n].stream )
  754.       break;
  755.   }
  756.   if ( n >= maxfiles )            /* non-ISO */
  757.     return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_files);
  758.  
  759.   fileTable[n].name        = name;
  760.   fileTable[n].stream_name = NULL_ATOM;
  761.   fileTable[n].type        = type;
  762.   fileTable[n].stream      = stream;
  763.  
  764.   switch(mode)
  765.   { case F_READ:
  766.       Input = n; break;
  767.     case F_WRITE:
  768.     case F_WRNOTRUNC:
  769.     case F_APPEND:
  770.       mode = F_WRITE;
  771.       Output = n; break;
  772.   }
  773.   fileTable[n].status = mode;
  774.  
  775.   DEBUG(2, Sdprintf("Prolog fileTable[] updated\n"));
  776.  
  777.   succeed;
  778. }
  779.  
  780.  
  781. static bool
  782. unifyStreamName(term_t f, int n)
  783. { if ( fileTable[n].status == F_CLOSED )
  784.     fail;
  785.  
  786.   if ( !(PL_is_variable(f) || PL_is_atom(f)) )
  787.     return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_variable, f);
  788.  
  789. #ifdef HAVE_POPEN
  790.   if ( fileTable[n].type == ST_PIPE )
  791.   { return PL_unify_term(f,
  792.              PL_FUNCTOR, FUNCTOR_pipe1,
  793.                PL_ATOM, fileTable[n].name);
  794.   }
  795. #endif /*HAVE_POPEN*/
  796.  
  797.   return PL_unify_atom(f, fileTable[n].name);
  798. }
  799.  
  800.  
  801. static bool
  802. unifyStreamMode(term_t m, int n)
  803. { if ( fileTable[n].status == F_CLOSED )
  804.     fail;
  805.  
  806.   return PL_unify_atom(m, fileTable[n].status == F_READ ? ATOM_read
  807.                             : ATOM_write);
  808. }
  809.  
  810.  
  811. static bool
  812. unifyStreamNo(term_t stream, int n)
  813. { atom_t name;
  814.  
  815.   switch( n )
  816.   { case 0:
  817.       name = ATOM_user_input;
  818.       break;
  819.     case 1:
  820.       name = ATOM_user_output;
  821.       break;
  822.     case 2:
  823.       name = ATOM_user_error;
  824.       break;
  825.     default:
  826.       if ( fileTable[n].stream_name )
  827.     name = fileTable[n].stream_name;
  828.       return PL_unify_integer(stream, n);
  829.   }
  830.  
  831.   return PL_unify_atom(stream, name);
  832. }
  833.  
  834.  
  835. word
  836. pl_told()
  837. { if ( fileTable[Output].status != F_WRITE )
  838.     succeed;
  839.  
  840.   closeStream(Output);
  841.  
  842.   Output = 1;
  843.   succeed;
  844. }  
  845.  
  846.  
  847. word
  848. pl_flush()
  849. { IOSTREAM *s;
  850.  
  851.   if ( fileTable[Output].status == F_WRITE &&
  852.        (s=fileTable[Output].stream) )
  853.   { TRYPIPE(Output, ATOM_write, Sflush(s), fail);
  854.   }
  855.  
  856.   succeed;
  857. }
  858.  
  859.  
  860. word
  861. pl_see(term_t f)
  862. { return openStream(f, F_READ, OPEN_TEXT);
  863. }
  864.  
  865.  
  866. word
  867. pl_seen()
  868. { if ( fileTable[Input].status != F_READ )
  869.     succeed;
  870.  
  871.   closeStream(Input);
  872.   popInputContext();
  873.  
  874.   succeed;
  875. }
  876.  
  877.  
  878. static word
  879. openProtocol(term_t f, bool appnd)
  880. { int out = Output;
  881.  
  882.   pl_noprotocol();
  883.  
  884.   if ( openStream(f, appnd ? F_APPEND : F_WRITE, OPEN_TEXT|OPEN_OPEN) )
  885.   { IOSTREAM *s = fileTable[Output].stream;
  886.  
  887.     s->flags |= SIO_NOCLOSE;
  888.     protocolStream = Output;
  889.     Output = out;
  890.  
  891.     succeed;
  892.   }
  893.   Output = out;
  894.  
  895.   fail;
  896. }
  897.  
  898.  
  899. word
  900. pl_noprotocol()
  901. { if ( protocolStream >= 0 )
  902.   { closeStream(protocolStream);
  903.     protocolStream = -1;
  904.   }
  905.  
  906.   succeed;
  907. }
  908.  
  909.  
  910.         /********************************
  911.         *          STRING I/O           *
  912.         *********************************/
  913.  
  914.  
  915. bool
  916. seeString(char *s)
  917. { IOSTREAM *stream = Sopen_string(NULL, s, -1, "r");
  918.   PlFile f;
  919.   int n;
  920.   
  921.   for(n=3, f=&fileTable[n]; n<maxfiles; n++, f++)
  922.   { if ( !f->stream )
  923.     { f->stream = stream;
  924.       f->name   = NULL_ATOM;
  925.       f->status = F_READ;
  926.       f->type   = ST_STRING;
  927.  
  928.       pushInputContext();
  929.       Input = n;
  930.       succeed;
  931.     }
  932.   }
  933.  
  934.   return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_files);
  935. }
  936.  
  937.  
  938. bool
  939. seeingString()
  940. { return fileTable[Input].type == ST_STRING;
  941. }
  942.  
  943.  
  944. bool
  945. seenString()
  946. { PlFile f = &fileTable[Input];
  947.  
  948.   if ( f->type == ST_STRING && f->stream )
  949.   { Sclose(f->stream);
  950.     f->stream = NULL;
  951.     f->status = F_CLOSED;
  952.     popInputContext();
  953.   }
  954.  
  955.   succeed;
  956. }
  957.  
  958.  
  959. bool
  960. tellString(char **s, int size)
  961. { static int sbuf;
  962.   IOSTREAM *stream;
  963.   PlFile f;
  964.   int n;
  965.   
  966.   sbuf = size;
  967.   stream = Sopenmem(s, &sbuf, "w");
  968.  
  969.   for(n=3, f=&fileTable[n]; n<maxfiles; n++, f++)
  970.   { if ( !f->stream )
  971.     { f->stream = stream;
  972.       f->name   = NULL_ATOM;
  973.       f->status = F_WRITE;
  974.       f->type   = ST_STRING;
  975.  
  976.       pushOutputContext();
  977.       Output = n;
  978.       succeed;
  979.     }
  980.   }
  981.  
  982.   return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_files);
  983. }
  984.  
  985.  
  986. bool
  987. toldString()
  988. { PlFile f = &fileTable[Output];
  989.  
  990.   if ( f->type == ST_STRING && f->stream )
  991.   { Sputc(EOS, f->stream);
  992.     Sclose(f->stream);
  993.     f->stream = NULL;
  994.     f->status = F_CLOSED;
  995.     popOutputContext();
  996.   }
  997.  
  998.   succeed;
  999. }
  1000.  
  1001.  
  1002.         /********************************
  1003.         *        INPUT IOSTREAM NAME    *
  1004.         *********************************/
  1005.  
  1006. atom_t
  1007. currentStreamName()            /* only if a file! */
  1008. { PlFile f = &fileTable[Input];
  1009.  
  1010.   if ( f->type == ST_FILE || f->type == ST_PIPE )
  1011.     return f->name;
  1012.  
  1013.   return NULL_ATOM;
  1014. }
  1015.  
  1016. void
  1017. setCurrentSourceLocation()
  1018. { PlFile f = &fileTable[Input];
  1019.  
  1020.   if ( f->type == ST_FILE || f->type == ST_PIPE )
  1021.   { IOSTREAM *stream = f->stream;
  1022.  
  1023.     source_file_name = f->name;
  1024.     if ( stream && stream->position )
  1025.     { source_line_no = stream->position->lineno;
  1026.       source_char_no = stream->position->charno - 1; /* char just read! */
  1027.     }
  1028.   } else
  1029.   { source_file_name = NULL_ATOM;
  1030.     source_line_no = -1;
  1031.     source_char_no = 0;
  1032.   }
  1033. }
  1034.  
  1035.         /********************************
  1036.         *       WAITING FOR INPUT    *
  1037.         ********************************/
  1038.  
  1039. #ifndef HAVE_SELECT
  1040.  
  1041. word
  1042. pl_wait_for_input(term_t streams, term_t available,
  1043.           term_t timeout)
  1044. { return notImplemented("wait_for_input", 3);
  1045. }
  1046.  
  1047. #else
  1048.  
  1049. word
  1050. pl_wait_for_input(term_t Streams, term_t Available,
  1051.           term_t timeout)
  1052. { fd_set fds;
  1053.   struct timeval t, *to;
  1054.   double time;
  1055.   int n, max = 0;
  1056.   char fdmap[256];
  1057.   term_t head      = PL_new_term_ref();
  1058.   term_t streams   = PL_copy_term_ref(Streams);
  1059.   term_t available = PL_copy_term_ref(Available);
  1060.  
  1061.   FD_ZERO(&fds);
  1062.   while( PL_get_list(streams, head, streams) )
  1063.   { IOSTREAM *s;
  1064.     int n, fd;
  1065.  
  1066.     if ( (n = streamNo(head, F_READ)) < 0 )
  1067.       fail;
  1068.     if ( !(s = fileTable[n].stream) || (fd=Sfileno(s)) < 0 )
  1069.       fail;
  1070.     fdmap[fd] = n;
  1071.  
  1072.     FD_SET(fd, &fds);
  1073.     if ( fd > max )
  1074.       max = fd;
  1075.   }
  1076.   if ( !PL_get_nil(streams) )
  1077.     return PL_error("wait_for_input", 3, NULL, ERR_TYPE, ATOM_list, Streams);
  1078.   if ( !PL_get_float(timeout, &time) )
  1079.     return PL_error("wait_for_input", 3, NULL, ERR_TYPE, ATOM_float, timeout);
  1080.   
  1081.   if ( time > 0.0 )
  1082.   { t.tv_sec  = (int)time;
  1083.     t.tv_usec = ((int)(time * 1000000) % 1000000);
  1084.     to = &t;
  1085.   } else
  1086.     to = NULL;
  1087.  
  1088. #ifdef hpux
  1089.   select(max+1, (int*) &fds, NULL, NULL, to);
  1090. #else
  1091.   select(max+1, &fds, NULL, NULL, to);
  1092. #endif
  1093.  
  1094.   for(n=0; n <= max; n++)
  1095.   { if ( FD_ISSET(n, &fds) )
  1096.     { if ( !PL_unify_list(available, head, available) ||
  1097.        !unifyStreamName(head, fdmap[n]) )
  1098.     fail;
  1099.     }
  1100.   }
  1101.   PL_unify_nil(available);
  1102.  
  1103.   succeed;
  1104. }
  1105.  
  1106. #endif /* HAVE_SELECT */
  1107.  
  1108.         /********************************
  1109.         *      PROLOG CONNECTION        *
  1110.         *********************************/
  1111.  
  1112. word
  1113. pl_put(term_t c)
  1114. { int chr;
  1115.   char *s;
  1116.  
  1117.   if ( PL_get_integer(c, &chr) )
  1118.   { if (chr < 0 || chr > 255)
  1119.       goto err;
  1120.     Put(chr);
  1121.   } else if ( PL_get_chars(c, &s, CVT_ATOM|CVT_LIST|CVT_STRING) )
  1122.   { Puts(s);
  1123.   } else
  1124.   { err:
  1125.     return PL_error("put", 1, NULL, ERR_TYPE, ATOM_character, c);
  1126.   }
  1127.  
  1128.   succeed;
  1129. }
  1130.  
  1131. word
  1132. pl_put2(term_t stream, term_t chr)
  1133. { streamOutput(stream, pl_put(chr));
  1134. }
  1135.  
  1136. word
  1137. pl_get(term_t chr)
  1138. { int c;
  1139.  
  1140.   do
  1141.   { c = Get0();
  1142.   } while( c != EOF && isBlank(c) );
  1143.  
  1144.   return PL_unify_integer(chr, c);
  1145. }
  1146.  
  1147.  
  1148. word
  1149. pl_skip(term_t chr)
  1150. { int c;
  1151.   int r;
  1152.  
  1153.   if ( !PL_get_integer(chr, &c) || c < 0 || c > 255 )
  1154.     return PL_error("skip", 1, NULL, ERR_TYPE, ATOM_character, chr);
  1155.  
  1156.   while((r=Get0()) != c && r != EOF )
  1157.     ;
  1158.  
  1159.   succeed;
  1160. }
  1161.  
  1162.  
  1163. word
  1164. pl_skip2(term_t stream, term_t chr)
  1165. { streamInput(stream, pl_skip(chr));
  1166. }
  1167.  
  1168.  
  1169. word
  1170. pl_get2(term_t stream, term_t chr)
  1171. { streamInput(stream, pl_get(chr));
  1172. }
  1173.  
  1174. word
  1175. pl_tty()                /* $tty/0 */
  1176. { if ( GD->cmdline.notty )
  1177.     fail;
  1178.   succeed;
  1179. }
  1180.  
  1181. word
  1182. pl_get_single_char(term_t c)
  1183. { return PL_unify_integer(c, getSingleChar());
  1184. }
  1185.  
  1186. word
  1187. pl_get0(term_t c)
  1188. { return PL_unify_integer(c, Get0());
  1189. }
  1190.  
  1191. word
  1192. pl_get02(term_t stream, term_t c)
  1193. { streamInput(stream, pl_get0(c))
  1194. }
  1195.  
  1196. word
  1197. pl_seeing(term_t f)
  1198. { return unifyStreamName(f, Input);
  1199. }
  1200.  
  1201. word
  1202. pl_telling(term_t f)
  1203. { return unifyStreamName(f, Output);
  1204. }
  1205.  
  1206. word
  1207. pl_tell(term_t f)
  1208. { return openStream(f, F_WRITE, OPEN_TEXT);
  1209. }
  1210.  
  1211. word
  1212. pl_append(term_t f)
  1213. { return openStream(f, F_APPEND, OPEN_TEXT);
  1214. }
  1215.  
  1216.  
  1217. word
  1218. pl_ttyflush()
  1219. { int OldOut = Output;
  1220.   bool rval;
  1221.  
  1222.   Output = 1;
  1223.   rval = pl_flush();
  1224.   Output = OldOut;
  1225.  
  1226.   return rval;
  1227. }
  1228.  
  1229.  
  1230. word
  1231. pl_protocol(term_t file)
  1232. { return openProtocol(file, FALSE);
  1233. }
  1234.  
  1235.  
  1236. word
  1237. pl_protocola(term_t file)
  1238. { return openProtocol(file, TRUE);
  1239. }
  1240.  
  1241.  
  1242. word
  1243. pl_protocolling(term_t file)
  1244. { if ( protocolStream >= 0 )
  1245.     return unifyStreamName(protocolStream, file);
  1246.  
  1247.   fail;
  1248. }
  1249.  
  1250.  
  1251. word
  1252. pl_prompt(term_t old, term_t new)
  1253. { atom_t a;
  1254.  
  1255.   if ( PL_unify_atom(old, prompt_atom) &&
  1256.        PL_get_atom(new, &a) )
  1257.   { prompt_atom = a;
  1258.     succeed;
  1259.   }
  1260.  
  1261.   fail;
  1262. }
  1263.  
  1264.  
  1265. void
  1266. prompt1(char *prompt)
  1267. { if ( first_prompt )
  1268.     remove_string(first_prompt);
  1269.   first_prompt = store_string(prompt);
  1270.   first_prompt_used = FALSE;
  1271. }
  1272.  
  1273.  
  1274. word
  1275. pl_prompt1(term_t prompt)
  1276. { char *s;
  1277.  
  1278.   if ( PL_get_chars(prompt, &s, CVT_ALL) )
  1279.   { prompt1(s);
  1280.     succeed;
  1281.   }
  1282.  
  1283.   return PL_error("prompt1", 1, NULL, ERR_TYPE, ATOM_atom, prompt);
  1284. }
  1285.  
  1286.  
  1287. word
  1288. pl_tab(term_t spaces)
  1289. { number n;
  1290.  
  1291.   if ( valueExpression(spaces, &n) &&
  1292.        toIntegerNumber(&n) )
  1293.   { int m = n.value.i;
  1294.  
  1295.     while(m-- > 0)
  1296.       Put(' ');
  1297.  
  1298.     succeed;
  1299.   }
  1300.  
  1301.   return PL_error("tab", 1, NULL, ERR_TYPE, ATOM_integer, spaces);
  1302. }
  1303.  
  1304.  
  1305. char *
  1306. PrologPrompt()
  1307. { if ( !first_prompt_used && first_prompt )
  1308.   { first_prompt_used = TRUE;
  1309.  
  1310.     return first_prompt;
  1311.   }
  1312.  
  1313.   if ( Sinput->position && Sinput->position->linepos == 0 )
  1314.     return stringAtom(prompt_atom);
  1315.   else
  1316.     return "";
  1317. }
  1318.  
  1319.  
  1320. word
  1321. pl_tab2(term_t stream, term_t n)
  1322. { streamOutput(stream, pl_tab(n)); /* TBD */
  1323. }
  1324.  
  1325.         /********************************
  1326.         *       STREAM BASED I/O        *
  1327.         *********************************/
  1328.  
  1329. static bool
  1330. setUnifyStreamNo(term_t stream, int n)
  1331. { atom_t a;
  1332.  
  1333.   if ( PL_get_atom(stream, &a) )
  1334.   { register int i;
  1335.  
  1336.     for(i = 0; i < maxfiles; i++ )
  1337.     { if ( fileTable[i].status != F_CLOSED &&
  1338.        fileTable[i].stream_name == a )
  1339.       { term_t obj = PL_new_term_ref();
  1340.  
  1341.     PL_unify_term(obj, PL_FUNCTOR, FUNCTOR_alias1, PL_ATOM, a);
  1342.  
  1343.     return PL_error(NULL, 0, NULL,
  1344.             ERR_PERMISSION, ATOM_open, ATOM_source_sink, obj);
  1345.       }
  1346.     }
  1347.     fileTable[n].stream_name = a;
  1348.     succeed;
  1349.   }
  1350.  
  1351.   return unifyStreamNo(stream, n);
  1352. }
  1353.       
  1354.  
  1355. static const opt_spec open4_options[] = 
  1356. { { ATOM_type,         OPT_ATOM },
  1357.   { ATOM_reposition,     OPT_BOOL },
  1358.   { ATOM_alias,             OPT_ATOM },
  1359.   { ATOM_eof_action,     OPT_ATOM },
  1360.   { ATOM_close_on_abort, OPT_BOOL },
  1361.   { ATOM_buffer,     OPT_ATOM },
  1362.   { NULL_ATOM,             0 }
  1363. };
  1364.  
  1365.  
  1366. word
  1367. pl_open4(term_t file, term_t mode,
  1368.      term_t stream, term_t options)
  1369. { int m = -1;
  1370.   atom_t mname;
  1371.   atom_t type           = ATOM_text;
  1372.   bool   reposition     = FALSE;
  1373.   atom_t alias            = NULL_ATOM;
  1374.   atom_t eof_action     = ATOM_eof_code;
  1375.   atom_t buffer         = ATOM_full;
  1376.   bool   close_on_abort = TRUE;
  1377.   int     flags          = OPEN_OPEN;
  1378.  
  1379.   if ( !scan_options(options, 0, ATOM_stream_option, open4_options,
  1380.              &type, &reposition, &alias, &eof_action,
  1381.              &close_on_abort, &buffer) )
  1382.     fail;
  1383.  
  1384.   if ( alias )
  1385.     TRY(PL_unify_atom(stream, alias));
  1386.   if ( type == ATOM_text )
  1387.     flags |= OPEN_TEXT;
  1388.   
  1389.   if ( PL_get_atom(mode, &mname) )
  1390.   {      if ( mname == ATOM_write )
  1391.       m = F_WRITE;
  1392.     else if ( mname == ATOM_append )
  1393.       m = F_APPEND;
  1394.     else if ( mname == ATOM_update )
  1395.       m = F_WRNOTRUNC;
  1396.     else if ( mname == ATOM_read )
  1397.       m = F_READ;
  1398.  
  1399.     if ( m < 0 )
  1400.       return PL_error("open", 4, NULL, ERR_DOMAIN, ATOM_io_mode, mode);
  1401.   } else
  1402.   { return PL_error("open", 4, NULL, ERR_TYPE, ATOM_atom, mode);
  1403.   }
  1404.  
  1405.   if ( m == F_READ )
  1406.   { int in = Input;
  1407.  
  1408.     if ( openStream(file, m, flags) )
  1409.     { if ( setUnifyStreamNo(stream, Input) )
  1410.       { IOSTREAM *s = fileTable[Input].stream;
  1411.       
  1412.     if ( eof_action != ATOM_eof_code )
  1413.     { if ( eof_action == ATOM_reset )
  1414.         s->flags |= SIO_NOFEOF;
  1415.       else if ( eof_action == ATOM_error )
  1416.         s->flags |= SIO_FEOF2ERR;
  1417.     }
  1418.     if ( !close_on_abort )
  1419.       s->flags |= SIO_NOCLOSE;
  1420.     Input = in;
  1421.     pushInputContext();
  1422.         succeed;
  1423.       }
  1424.       closeStream(Input);
  1425.       Input = in;
  1426.  
  1427.       fail;
  1428.     }
  1429.     Input = in;
  1430.     fail;
  1431.   } else
  1432.   { int out = Output;
  1433.     if ( openStream(file, m, flags) )
  1434.     { if ( setUnifyStreamNo(stream, Output) )
  1435.       { IOSTREAM *s = fileTable[Output].stream;
  1436.  
  1437.     if ( !close_on_abort )
  1438.       s->flags |= SIO_NOCLOSE;
  1439.     if ( buffer != ATOM_full )
  1440.     { s->flags &= ~SIO_FBUF;
  1441.       if ( buffer == ATOM_line )
  1442.         s->flags |= SIO_LBUF;
  1443.       if ( buffer == ATOM_false )
  1444.         s->flags |= SIO_NBUF;
  1445.     }
  1446.  
  1447.     Output = out;
  1448.         succeed;
  1449.       }
  1450.       closeStream(Output);
  1451.       Output = out;
  1452.       
  1453.       fail;
  1454.     }
  1455.     Output = out;
  1456.     fail;
  1457.   }
  1458. }
  1459.  
  1460.  
  1461. word
  1462. pl_open(term_t file, term_t mode, term_t stream)
  1463. { term_t n = PL_new_term_ref();
  1464.   PL_put_nil(n);
  1465.  
  1466.   return pl_open4(file, mode, stream, n);
  1467. }
  1468.  
  1469.  
  1470.          /*******************************
  1471.          *       NULL-STREAM        *
  1472.          *******************************/
  1473.  
  1474. static int
  1475. Swrite_null(void *handle, char *buf, int size)
  1476. { return size;
  1477. }
  1478.  
  1479.  
  1480. static int
  1481. Sread_null(void *handle, char *buf, int size)
  1482. { return 0;
  1483. }
  1484.  
  1485.  
  1486. static long
  1487. Sseek_null(void *handle, long offset, int whence)
  1488. { switch(whence)
  1489.   { case SIO_SEEK_SET:
  1490.     return offset;
  1491.     case SIO_SEEK_CUR:
  1492.     case SIO_SEEK_END:
  1493.     default:
  1494.         return -1;
  1495.   }
  1496. }
  1497.  
  1498.  
  1499. static int
  1500. Sclose_null(void *handle)
  1501. { return 0;
  1502. }
  1503.  
  1504.  
  1505. static IOFUNCTIONS nullFunctions =
  1506. { Sread_null,
  1507.   Swrite_null,
  1508.   Sseek_null,
  1509.   Sclose_null
  1510. };
  1511.  
  1512.  
  1513. word
  1514. pl_open_null_stream(term_t stream)
  1515. { int sflags = SIO_NBUF|SIO_RECORDPOS;
  1516.   IOSTREAM *s = Snew((void *)NULL, sflags, &nullFunctions);
  1517.  
  1518.   return PL_open_stream(stream, s);
  1519. }
  1520.  
  1521.  
  1522. int
  1523. streamNo(term_t spec, int mode)
  1524. { int n = -1;
  1525.   
  1526.   if ( !PL_get_integer(spec, &n) )
  1527.   { atom_t name;
  1528.  
  1529.     if ( PL_get_atom(spec, &name) )
  1530.     {      if ( name == ATOM_user )
  1531.     n = (mode == F_READ ? 0 : 1);
  1532.       else if ( name == ATOM_user_input )
  1533.     n = 0;
  1534.       else if ( name == ATOM_user_output )
  1535.         n = 1;
  1536.       else if ( name == ATOM_user_error )
  1537.         n = 2;
  1538.       else
  1539.       { int i;
  1540.  
  1541.     for(i = 3; i < maxfiles; i++)
  1542.     { if ( fileTable[i].stream_name == name )
  1543.       { n = i;
  1544.         break;
  1545.       }
  1546.     }
  1547.       }
  1548.     }
  1549.   }
  1550.  
  1551.   if ( n < 0 || n >= maxfiles )
  1552.   { PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream_or_alias, spec);
  1553.     return -1;
  1554.   }
  1555.   if ( fileTable[n].status == F_CLOSED )
  1556.   { PL_error(NULL, 0, "closed", ERR_EXISTENCE, ATOM_stream, spec);
  1557.     return -1;
  1558.   }
  1559.  
  1560.   switch(mode)
  1561.   { case F_ANY:
  1562.       return n;
  1563.     case F_READ:
  1564.       if ( fileTable[n].status != F_READ )
  1565.       { PL_error(NULL, 0, NULL, ERR_PERMISSION,
  1566.          ATOM_input, ATOM_stream, spec);
  1567.     return -1;
  1568.       }
  1569.       break;
  1570.     case F_APPEND:
  1571.     case F_WRNOTRUNC:
  1572.     case F_WRITE:    
  1573.       if ( fileTable[n].status != F_WRITE )
  1574.       { PL_error(NULL, 0, NULL, ERR_PERMISSION,
  1575.          ATOM_output, ATOM_stream, spec);
  1576.         return -1;
  1577.       }
  1578.   }
  1579.  
  1580.   return n;
  1581. }
  1582.   
  1583.  
  1584. word
  1585. pl_close(term_t stream)
  1586. { int n;
  1587.   int isread;
  1588.  
  1589.   if ( (n = streamNo(stream, F_ANY)) < 0 )
  1590.     fail;
  1591.   isread = (fileTable[n].status == F_READ);
  1592.  
  1593.   TRY( closeStream(n) );
  1594.   if ( isread )
  1595.     popInputContext();
  1596.   
  1597.   if ( n == Output )
  1598.     Output = 1;
  1599.   if ( n == Input )
  1600.     Input = 0;
  1601.  
  1602.   succeed;
  1603. }
  1604.  
  1605. word
  1606. pl_current_stream(term_t file, term_t mode,
  1607.           term_t stream, word h)
  1608. { int n;
  1609.  
  1610.   switch( ForeignControl(h) )
  1611.   { case FRG_FIRST_CALL:
  1612.       n = 3;
  1613.       break;
  1614.     case FRG_REDO:
  1615.       n = ForeignContextInt(h);
  1616.       break;
  1617.     case FRG_CUTTED:
  1618.     default:
  1619.       succeed;
  1620.   }
  1621.   
  1622.   for( ; n < maxfiles; n++)
  1623.   { fid_t fid = PL_open_foreign_frame();
  1624.  
  1625.     if ( unifyStreamName(file, n) == FALSE ||
  1626.      unifyStreamMode(mode, n) == FALSE ||
  1627.      unifyStreamNo(stream, n) == FALSE )
  1628.     { PL_discard_foreign_frame(fid);
  1629.       continue;
  1630.     }
  1631.  
  1632.     PL_close_foreign_frame(fid);
  1633.  
  1634.     if ( ++n < maxfiles )
  1635.       ForeignRedoInt(n);
  1636.  
  1637.     succeed;
  1638.   }
  1639.   
  1640.   fail;
  1641. }      
  1642.  
  1643.  
  1644. word
  1645. pl_flush_output(term_t stream)
  1646. { int n;
  1647.  
  1648.   if ( (n = streamNo(stream, F_WRITE)) < 0 )
  1649.     fail;
  1650.   TRYPIPE(n, ATOM_write, Sflush(fileTable[n].stream), fail);
  1651.  
  1652.   succeed;
  1653. }
  1654.  
  1655.  
  1656. static IOSTREAM *
  1657. ioStreamWithPosition(term_t stream)
  1658. { int n;
  1659.   IOSTREAM *s;
  1660.  
  1661.   if ( (n = streamNo(stream, F_ANY)) < 0 )
  1662.     fail;
  1663.   s = fileTable[n].stream;
  1664.   if ( !s->position )
  1665.   { PL_error(NULL, 0, NULL, ERR_PERMISSION, /* non-ISO */
  1666.          ATOM_property, ATOM_position, stream);
  1667.     return NULL;
  1668.   }
  1669.   
  1670.   return s;
  1671. }
  1672.  
  1673.  
  1674. word
  1675. pl_stream_position(term_t stream, term_t old, term_t new)
  1676. { IOSTREAM *s;
  1677.   long oldcharno, charno, linepos, lineno;
  1678.   term_t a = PL_new_term_ref();
  1679.   functor_t f;
  1680.  
  1681.   if ( !(s = ioStreamWithPosition(stream)) )
  1682.     fail;
  1683.  
  1684.   charno  = s->position->charno;
  1685.   lineno  = s->position->lineno;
  1686.   linepos = s->position->linepos;
  1687.   oldcharno = charno;
  1688.  
  1689.   if ( !PL_unify_functor(old, FUNCTOR_stream_position3) ||
  1690.        !PL_get_arg(1, old, a) ||
  1691.        !PL_unify_integer(a, charno) ||
  1692.        !PL_get_arg(2, old, a) ||
  1693.        !PL_unify_integer(a, lineno) ||
  1694.        !PL_get_arg(3, old, a) ||
  1695.        !PL_unify_integer(a, linepos) )
  1696.     fail;
  1697.  
  1698.   if ( !(PL_get_functor(new, &f) && f == FUNCTOR_stream_position3) ||
  1699.        !PL_get_arg(1, new, a) ||
  1700.        !PL_get_long(a, &charno) ||
  1701.        !PL_get_arg(2, new, a) ||
  1702.        !PL_get_long(a, &lineno) ||
  1703.        !PL_get_arg(3, new, a) ||
  1704.        !PL_get_long(a, &linepos) )
  1705.     return PL_error("stream_position", 3, NULL,
  1706.             ERR_DOMAIN, ATOM_stream_position, new);
  1707.  
  1708.   if ( charno != oldcharno && Sseek(s, charno, 0) < 0 )
  1709.     return PL_error("stream_position", 3, OsError(),
  1710.             ERR_STREAM_OP, ATOM_position, stream);
  1711.  
  1712.   s->position->charno  = charno;
  1713.   s->position->lineno  = lineno;
  1714.   s->position->linepos = linepos;
  1715.   
  1716.   succeed;
  1717. }
  1718.  
  1719.  
  1720. word
  1721. pl_set_input(term_t stream)
  1722. { int n;
  1723.  
  1724.   if ( (n = streamNo(stream, F_READ)) < 0 )
  1725.     fail;
  1726.  
  1727.   Input = n;
  1728.   succeed;
  1729. }
  1730.  
  1731.  
  1732. word
  1733. pl_set_output(term_t stream)
  1734. { int n;
  1735.  
  1736.   if ( (n = streamNo(stream, F_WRITE)) < 0 )
  1737.     fail;
  1738.  
  1739.   Output = n;
  1740.   succeed;
  1741. }
  1742.  
  1743.  
  1744. word
  1745. pl_current_input(term_t stream)
  1746. { return unifyStreamNo(stream, Input);
  1747. }
  1748.  
  1749.  
  1750. word
  1751. pl_current_output(term_t stream)
  1752. { return unifyStreamNo(stream, Output);
  1753. }
  1754.  
  1755. word
  1756. pl_character_count(term_t stream, term_t count)
  1757. { IOSTREAM *s = ioStreamWithPosition(stream);
  1758.  
  1759.   if ( s )
  1760.     return PL_unify_integer(count, s->position->charno);
  1761.  
  1762.   fail;
  1763. }
  1764.  
  1765. word
  1766. pl_line_count(term_t stream, term_t count)
  1767. { IOSTREAM *s = ioStreamWithPosition(stream);
  1768.  
  1769.   if ( s )
  1770.     return PL_unify_integer(count, s->position->lineno);
  1771.  
  1772.   fail;
  1773. }
  1774.  
  1775. word
  1776. pl_line_position(term_t stream, term_t count)
  1777. { IOSTREAM *s = ioStreamWithPosition(stream);
  1778.  
  1779.   if ( s )
  1780.     return PL_unify_integer(count, s->position->linepos);
  1781.  
  1782.   fail;
  1783. }
  1784.  
  1785.  
  1786. word
  1787. pl_source_location(term_t file, term_t line)
  1788. { char *s;
  1789.   char tmp[MAXPATHLEN];
  1790.  
  1791.   if ( ReadingSource &&
  1792.        (s = AbsoluteFile(stringAtom(source_file_name), tmp)) &&
  1793.     PL_unify_atom_chars(file, s) &&
  1794.     PL_unify_integer(line, source_line_no) )
  1795.     succeed;
  1796.   
  1797.   fail;
  1798. }
  1799.  
  1800.  
  1801. word
  1802. pl_at_end_of_stream1(term_t stream)
  1803. { int n;
  1804.  
  1805.   if ( (n = streamNo(stream, F_READ)) < 0 )
  1806.     fail;
  1807.  
  1808.   return Sfeof(fileTable[n].stream) ? TRUE : FALSE;
  1809. }
  1810.  
  1811.  
  1812. word
  1813. pl_at_end_of_stream0()
  1814. { IOSTREAM *s = fileTable[Input].stream;
  1815.   
  1816.   if ( !s || Sfeof(s) )
  1817.     succeed;
  1818.  
  1819.   fail;
  1820. }
  1821.  
  1822.  
  1823. word
  1824. pl_peek_byte2(term_t stream, term_t chr)
  1825. { int n;
  1826.   IOSTREAM *s;
  1827.   IOPOS pos;
  1828.   int c;
  1829.  
  1830.   if ( (n = streamNo(stream, F_READ)) < 0 ||
  1831.        !(s = fileTable[n].stream) )
  1832.     fail;
  1833.  
  1834.   pos = s->posbuf;
  1835.   c = Sgetc(s);
  1836.   Sungetc(c, s);
  1837.   s->posbuf = pos;
  1838.  
  1839.   return PL_unify_integer(chr, c);
  1840. }
  1841.  
  1842.  
  1843. word
  1844. pl_peek_byte1(term_t chr)
  1845. { IOSTREAM *s;
  1846.   IOPOS pos;
  1847.   int c;
  1848.  
  1849.   if ( !(s = fileTable[Input].stream) )
  1850.     fail;
  1851.  
  1852.   pos = s->posbuf;
  1853.   c = Sgetc(s);
  1854.   Sungetc(c, s);
  1855.   s->posbuf = pos;
  1856.  
  1857.   return PL_unify_integer(chr, c);
  1858. }
  1859.  
  1860.  
  1861.         /********************************
  1862.         *             FILES             *
  1863.         *********************************/
  1864.  
  1865. bool
  1866. unifyTime(term_t t, long time)
  1867. { return PL_unify_float(t, (double)time);
  1868. }
  1869.  
  1870.  
  1871. char *
  1872. PL_get_filename(term_t n, char *buf, unsigned int size)
  1873. { char *name;
  1874.   char tmp[MAXPATHLEN];
  1875.  
  1876.   if ( !PL_get_chars(n, &name, CVT_ALL) )
  1877.   { PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, n);
  1878.     return NULL;
  1879.   }
  1880.   if ( !(name = ExpandOneFile(name, tmp)) )
  1881.     return NULL;
  1882.  
  1883.   if ( buf )
  1884.   { if ( strlen(name) < size )
  1885.     { strcpy(buf, name);
  1886.       return buf;
  1887.     }
  1888.  
  1889.     PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
  1890.          ATOM_max_path_length);
  1891.     return NULL;
  1892.   } else
  1893.     return buffer_string(name, 0);
  1894. }
  1895.  
  1896.  
  1897. word
  1898. pl_time_file(term_t name, term_t t)
  1899. { char *fn;
  1900.  
  1901.   if ( (fn = PL_get_filename(name, NULL, 0)) )
  1902.   { long time;
  1903.  
  1904.     if ( (time = LastModifiedFile(fn)) == -1 )
  1905.       fail;
  1906.  
  1907.     return unifyTime(t, time);
  1908.   }
  1909.  
  1910.   fail;
  1911. }
  1912.  
  1913.  
  1914. word
  1915. pl_size_file(term_t name, term_t len)
  1916. { char *n;
  1917.  
  1918.   if ( (n = PL_get_filename(name, NULL, 0)) )
  1919.   { long size;
  1920.  
  1921.     if ( (size = SizeFile(n)) < 0 )
  1922.       return PL_error("size_file", 2, OsError(), ERR_FILE_OPERATION,
  1923.               ATOM_size, ATOM_file, name);
  1924.  
  1925.     return PL_unify_integer(len, size);
  1926.   }
  1927.  
  1928.   fail;
  1929. }
  1930.  
  1931.  
  1932. word
  1933. pl_access_file(term_t name, term_t mode)
  1934. { char *n;
  1935.   int md;
  1936.   atom_t m;
  1937.  
  1938.   if ( !PL_get_atom(mode, &m) )
  1939.     return PL_error("access_file", 2, NULL, ERR_TYPE, ATOM_atom, mode);
  1940.   if ( !(n=PL_get_filename(name, NULL, 0)) )
  1941.     fail;
  1942.  
  1943.   if ( m == ATOM_none )
  1944.     succeed;
  1945.   
  1946.   if      ( m == ATOM_write || m == ATOM_append )
  1947.     md = ACCESS_WRITE;
  1948.   else if ( m == ATOM_read )
  1949.     md = ACCESS_READ;
  1950.   else if ( m == ATOM_execute )
  1951.     md = ACCESS_EXECUTE;
  1952.   else if ( m == ATOM_exist )
  1953.     md = ACCESS_EXIST;
  1954.   else
  1955.     return PL_error("access_file", 2, NULL, ERR_DOMAIN, ATOM_io_mode, mode);
  1956.  
  1957.   if ( AccessFile(n, md) )
  1958.     succeed;
  1959.  
  1960.   if ( md == ACCESS_WRITE && !AccessFile(n, ACCESS_EXIST) )
  1961.   { char tmp[MAXPATHLEN];
  1962.     char *dir = DirName(n, tmp);
  1963.  
  1964.     if ( dir[0] )
  1965.     { if ( !ExistsDirectory(dir) )
  1966.     fail;
  1967.     }
  1968.     if ( AccessFile(dir[0] ? dir : ".", md) )
  1969.       succeed;
  1970.   }
  1971.  
  1972.   fail;
  1973. }
  1974.  
  1975.  
  1976. word
  1977. pl_read_link(term_t file, term_t link, term_t to)
  1978. { char *n, *l, *t;
  1979.   char buf[MAXPATHLEN];
  1980.  
  1981.   if ( !(n = PL_get_filename(file, NULL, 0)) )
  1982.     fail;
  1983.  
  1984.   if ( (l = ReadLink(n, buf)) &&
  1985.        PL_unify_atom_chars(link, l) &&
  1986.        (t = DeRefLink(n, buf)) &&
  1987.        PL_unify_atom_chars(to, t) )
  1988.     succeed;
  1989.  
  1990.   fail;
  1991. }
  1992.  
  1993.  
  1994. word
  1995. pl_exists_file(term_t name)
  1996. { char *n;
  1997.  
  1998.   if ( !(n = PL_get_filename(name, NULL, 0)) )
  1999.     fail;
  2000.   
  2001.   return ExistsFile(n);
  2002. }
  2003.  
  2004.  
  2005. word
  2006. pl_exists_directory(term_t name)
  2007. { char *n;
  2008.  
  2009.   if ( !(n = PL_get_filename(name, NULL, 0)) )
  2010.     fail;
  2011.   
  2012.   return ExistsDirectory(n);
  2013. }
  2014.  
  2015.  
  2016. word
  2017. pl_tmp_file(term_t base, term_t name)
  2018. { char *n;
  2019.  
  2020.   if ( !PL_get_chars(base, &n, CVT_ALL) )
  2021.     return PL_error("tmp_file", 2, NULL, ERR_TYPE, ATOM_atom, base);
  2022.  
  2023.   return PL_unify_atom(name, TemporaryFile(n));
  2024. }
  2025.  
  2026.  
  2027. word
  2028. pl_delete_file(term_t name)
  2029. { char *n;
  2030.  
  2031.   if ( !(n = PL_get_filename(name, NULL, 0)) )
  2032.     fail;
  2033.   
  2034.   return RemoveFile(n);
  2035. }
  2036.  
  2037.  
  2038. word
  2039. pl_same_file(term_t file1, term_t file2)
  2040. { char *n1, *n2;
  2041.   char name1[MAXPATHLEN];
  2042.  
  2043.   if ( (n1 = PL_get_filename(file1, name1, sizeof(name1))) &&
  2044.        (n2 = PL_get_filename(file2, NULL, 0)) )
  2045.     return SameFile(name1, n2);
  2046.  
  2047.   fail;
  2048. }
  2049.  
  2050.  
  2051. word
  2052. pl_rename_file(term_t old, term_t new)
  2053. { char *o, *n;
  2054.   char ostore[MAXPATHLEN];
  2055.  
  2056.   if ( (o = PL_get_filename(old, ostore, sizeof(ostore))) &&
  2057.        (n = PL_get_filename(new, NULL, 0)) )
  2058.   { if ( RenameFile(ostore, n) )
  2059.       succeed;
  2060.  
  2061.     if ( fileerrors )
  2062.       return PL_error("rename_file", 2, OsError(), ERR_FILE_OPERATION,
  2063.               ATOM_rename, ATOM_file, old);
  2064.     fail;
  2065.   }
  2066.  
  2067.   fail;
  2068. }
  2069.  
  2070.  
  2071. word
  2072. pl_fileerrors(term_t old, term_t new)
  2073. { return setBoolean(&fileerrors, "fileerrors", old, new);
  2074. }
  2075.  
  2076.  
  2077. word
  2078. pl_absolute_file_name(term_t name, term_t expanded)
  2079. { char *n;
  2080.   char tmp[MAXPATHLEN];
  2081.  
  2082.   if ( (n = PL_get_filename(name, NULL, 0)) &&
  2083.        (n = AbsoluteFile(n, tmp)) )
  2084.     return PL_unify_atom_chars(expanded, n);
  2085.  
  2086.   fail;
  2087. }
  2088.  
  2089.  
  2090. word
  2091. pl_is_absolute_file_name(term_t name)
  2092. { char *n;
  2093.  
  2094.   if ( (n = PL_get_filename(name, NULL, 0)) &&
  2095.        IsAbsolutePath(n) )
  2096.     succeed;
  2097.  
  2098.   fail;
  2099. }
  2100.  
  2101.  
  2102. word
  2103. pl_chdir(term_t dir)
  2104. { char *n;
  2105.  
  2106.   if ( (n = PL_get_filename(dir, NULL, 0)) )
  2107.   { if ( ChDir(n) )
  2108.       succeed;
  2109.  
  2110.     if ( fileerrors )
  2111.       return PL_error("chdir", 1, NULL, ERR_FILE_OPERATION,
  2112.               ATOM_chdir, ATOM_directory, dir);
  2113.     fail;
  2114.   }
  2115.  
  2116.   fail;
  2117. }
  2118.  
  2119.  
  2120. word
  2121. pl_file_base_name(term_t f, term_t b)
  2122. { char *n;
  2123.  
  2124.   if ( !PL_get_chars(f, &n, CVT_ALL) )
  2125.     return PL_error("file_base_name", 2, NULL, ERR_TYPE, ATOM_atom, f);
  2126.  
  2127.   return PL_unify_atom_chars(b, BaseName(n));
  2128. }
  2129.  
  2130.  
  2131. word
  2132. pl_file_dir_name(term_t f, term_t b)
  2133. { char *n;
  2134.   char tmp[MAXPATHLEN];
  2135.  
  2136.   if ( !PL_get_chars(f, &n, CVT_ALL) )
  2137.     return PL_error("file_dir_name", 2, NULL, ERR_TYPE, ATOM_atom, f);
  2138.  
  2139.   return PL_unify_atom_chars(b, DirName(n, tmp));
  2140. }
  2141.  
  2142.  
  2143. static int
  2144. has_extension(const char *name, const char *ext)
  2145. { const char *s = name + strlen(name);
  2146.  
  2147.   if ( ext[0] == EOS )
  2148.     succeed;
  2149.  
  2150.   while(*s != '.' && *s != '/' && s > name)
  2151.     s--;
  2152.   if ( *s == '.' && s > name && s[-1] != '/' )
  2153.   { if ( ext[0] == '.' )
  2154.       ext++;
  2155.     if ( trueFeature(FILE_CASE_FEATURE) )
  2156.       return strcmp(&s[1], ext) == 0;
  2157.     else
  2158.       return stricmp(&s[1], ext) == 0;
  2159.   }
  2160.  
  2161.   fail;
  2162. }
  2163.  
  2164.  
  2165. word
  2166. pl_file_name_extension(term_t base, term_t ext, term_t full)
  2167. { char *b = NULL, *e = NULL, *f;
  2168.   char buf[MAXPATHLEN];
  2169.  
  2170.   if ( PL_get_chars(full, &f, CVT_ALL) )
  2171.   { char *s = f + strlen(f);        /* ?base, ?ext, +full */
  2172.  
  2173.     while(*s != '.' && *s != '/' && s > f)
  2174.       s--;
  2175.     if ( *s == '.' )
  2176.     { if ( PL_get_chars(ext, &e, CVT_ALL) )
  2177.       { if ( e[0] == '.' )
  2178.       e++;
  2179.     if ( trueFeature(FILE_CASE_FEATURE) )
  2180.     { TRY(strcmp(&s[1], e) == 0);
  2181.     } else
  2182.     { TRY(stricmp(&s[1], e) == 0);
  2183.     }
  2184.       } else
  2185.       { TRY(PL_unify_atom_chars(ext, &s[1]));
  2186.       }
  2187.       if ( s-f > MAXPATHLEN )
  2188.       { maxpath:
  2189.     return PL_error("file_name_extension", 3, NULL, ERR_REPRESENTATION,
  2190.             ATOM_max_path_length);
  2191.       }
  2192.       strncpy(buf, f, s-f);
  2193.       buf[s-f] = EOS;
  2194.  
  2195.       return PL_unify_atom_chars(base, buf);
  2196.     }
  2197.     if ( PL_unify_atom_chars(ext, "") &&
  2198.      PL_unify(full, base) )
  2199.       PL_succeed;
  2200.  
  2201.     PL_fail;
  2202.   } else if ( !PL_is_variable(full) )
  2203.     return PL_error("file_name_extension", 3, NULL, ERR_TYPE,
  2204.             ATOM_atom, full);
  2205.  
  2206.   if ( PL_get_chars(base, &b, CVT_ALL|BUF_RING) &&
  2207.        PL_get_chars(ext, &e, CVT_ALL) )
  2208.   { char *s;
  2209.  
  2210.     if ( e[0] == '.' )        /* +Base, +Extension, -full */
  2211.       e++;
  2212.     if ( has_extension(b, e) )
  2213.       return PL_unify(base, full);
  2214.     if ( strlen(b) + 1 + strlen(e) + 1 > MAXPATHLEN )
  2215.       goto maxpath;
  2216.     strcpy(buf, b);
  2217.     s = buf + strlen(buf);
  2218.     *s++ = '.';
  2219.     strcpy(s, e);
  2220.  
  2221.     return PL_unify_atom_chars(full, buf);
  2222.   }
  2223.  
  2224.   if ( !b )
  2225.     return PL_error("file_name_extension", 3, NULL, ERR_TYPE,
  2226.             ATOM_atom, base);
  2227.   return PL_error("file_name_extension", 3, NULL, ERR_TYPE,
  2228.           ATOM_atom, ext);
  2229. }
  2230.  
  2231.  
  2232. word
  2233. pl_prolog_to_os_filename(term_t pl, term_t os)
  2234. {
  2235. #ifdef O_XOS
  2236.   char *n;
  2237.   char buf[MAXPATHLEN];
  2238.  
  2239.   if ( PL_get_chars(pl, &n, CVT_ALL) )
  2240.   { _xos_os_filename(n, buf);
  2241.     return PL_unify_atom_chars(os, buf);
  2242.   }
  2243.   if ( !PL_is_variable(pl) )
  2244.     return PL_error("prolog_to_os_filename", 2, NULL, ERR_TYPE,
  2245.             ATOM_atom, pl);
  2246.  
  2247.   if ( PL_get_chars(os, &n, CVT_ALL) )
  2248.   { _xos_canonical_filename(n, buf);
  2249.     return PL_unify_atom_chars(pl, buf);
  2250.   }
  2251.  
  2252.   return PL_error("prolog_to_os_filename", 2, NULL, ERR_TYPE,
  2253.           ATOM_atom, os);
  2254. #else /*O_XOS*/
  2255.   return PL_unify(pl, os);
  2256. #endif /*O_XOS*/
  2257. }
  2258.  
  2259.  
  2260. #if defined(O_XOS) && defined(__WIN32__)
  2261. word
  2262. pl_make_fat_filemap(term_t dir)
  2263. { char *n;
  2264.  
  2265.   if ( (n = PL_get_filename(dir, NULL, 0)) )
  2266.   { if ( _xos_make_filemap(n) == 0 )
  2267.       succeed;
  2268.  
  2269.     if ( fileerrors )
  2270.       return PL_error("make_fat_filemap", 1, NULL, ERR_FILE_OPERATION,
  2271.               ATOM_write, ATOM_file, dir);
  2272.  
  2273.     fail;
  2274.   }
  2275.   
  2276.   fail;
  2277. }
  2278. #endif
  2279.